home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol188 / lisplib < prev    next >
Encoding:
Text File  |  1986-11-25  |  1.9 KB  |  88 lines
  1.  
  2. (defun append (x y)
  3.    (cond ((null x) y)
  4.          (t (cons (car x) (append (cdr x) y)))
  5.    ) )
  6.  
  7. (defun member (a lat)
  8.    (cond ((null lat) nil)
  9.          ((eq (car lat) a) t)
  10.          (t (member a (cdr lat)))
  11.    ) )
  12.  
  13.  
  14. (defun eqn (n1 n2)
  15.    (cond ((zerop n2) (zerop n1))
  16.          ((zerop n1) nil)
  17.          (t (eqn (sub1 n1) (sub1 n2)))
  18.    ) )
  19.  
  20. (defun eqan (a1 a2)
  21.    (cond ((and (numberp a1) (numberp a2)) (eqn a1 a2))
  22.          ((or (numberp a1) (numberp a2)) nil)
  23.          (t (eq a1 a2))
  24.    ) )
  25.  
  26. (defun equal (s1 s2)
  27.    (cond ((atom x) (eq x y))
  28.          ((atom y) nil)
  29.          ((equal (car x) (car y)) (equal (cdr x) (cdr y)))
  30.          (t nil)
  31.    ) )
  32.  
  33. (defun equal2 (s1 s2)
  34.    (cond ((and (not (atom s1)) (not (atom s2)))
  35.               (and (equal2 (car s1) (car s2)) (equal2 (cdr s1) (cdr s2))))
  36.           ((and (atom s1) (atom s2)) (eqan s1 s2))
  37.           (t nil)
  38.    ) )
  39.  
  40.  
  41. (defun subst (old new lat)
  42.    (cond ((null lat) ())
  43.          ((eq (car lat) old) (cons new (cdr lat)))
  44.          (t (cons (car lat) (subst old new (cdr lat))))
  45.    )  )
  46.  
  47. (defun length (lat)
  48.    (cond ((null lat) 0)
  49.          (t (add1 (length (cdr lat))))
  50.    ) )
  51.  
  52. (defun intersect (set1 set2)
  53.    (cond ((null set1) ())
  54.      ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2)))
  55.      (t (intersect (cdr set1) set2))
  56.    ) )
  57.  
  58. (defun mapcar (fn x)
  59.    (cond ((null x) nil)
  60.          (t (cons (funcall fn (car x)) (mapcar fn (cdr x))))
  61.    ) )
  62.  
  63. (defun maplist (fn x)
  64.    (cond ((null x) nil)
  65.          (t (cons (funcall fn x) (maplist fn (cdr x))))
  66.    ) )
  67.  
  68. (defun mapc (fn x)
  69.  (prog ()
  70. a  (cond ((atom x) (return x)))
  71.    (funcall fn (car x))
  72.    (setq x (cdr x))
  73.    (go a)
  74.  )
  75. )
  76.  
  77. (defun map (fn x)
  78.  (prog ()
  79.    loop (cond ((atom x) (return x))
  80.               ((null x) (return nil))
  81.         )
  82.         (funcall fn x)
  83.         (setq x (cdr x))
  84.         (go loop)
  85.  )
  86. )
  87.  
  88. ADMIN>